home *** CD-ROM | disk | FTP | other *** search
/ Aminet 43 / Aminet 43 (2001)(GTI - Schatztruhe)[!][Jun 2001].iso / Aminet / demo / mag / hLA-AP15.lha / hLA-AP15 / bonus / zdroj.lha / radix.s < prev   
Text File  |  2000-05-01  |  3KB  |  164 lines
  1.  
  2.     incdir    "include:"
  3.     include    "system.gs"
  4.     
  5.     bsr    Start        ;otevÒenÉ okna a alokace vseho
  6.     bsr    Generuj
  7.     bsr    vypis
  8.     
  9.     bsr    utrid
  10.     bsr    vypis
  11.  
  12. konec3    move.l    vystup,d1
  13.     CALLDOS    Close
  14. konec2    move.l    _DOSBase,a1
  15.     CALLEXEC    CloseLibrary
  16. konec1    rts
  17.  
  18. *** Podprogramy ***
  19.  
  20. utrid    
  21.     ;inicializujeme si ukazatele
  22.     move.l    #ukpp,a0
  23.     move.l    #pompole,a1
  24.     moveq    #16-1,d7
  25. utlab1    move.l    a1,(a0)+
  26.     add.l    #200,a1
  27.     dbra    d7,utlab1
  28.  
  29.     moveq    #0,d6
  30. utlab7    
  31.     ;nulujeme pocty prvku v prihradkach
  32.     moveq    #16-1,d7
  33.     move.l    #ukpp,a0
  34. utlab8    move.l    (a0)+,a1
  35.     move.w    #0,(a1)
  36.     dbra    d7,utlab8
  37.     
  38.     ;a rozÒaÄujeme
  39.     moveq    #100-1,d7        ;pÒes vÓechny udaje v poli
  40.     move.l    #ukpp,a1
  41.     move.l    #pole,a0
  42. utlab2    move.w    (a0,d7*2),d0    ;hodnotu do d0
  43.     move.w    d0,d1        ;pro pozdejsi ukladani
  44.     lsr.w    d6,d0
  45.     and.w    #$000F,d0        ;a v d0 mame jen hodnotu v potrebnem radu
  46.     move.l    (a1,d0*4),a2    ;adresa prihradky
  47.     add.w    #1,(a2)        ;budeme pridavat - je jich tedy o 1 vic
  48.     move.w    (a2),d3        ;pocet prvku v teto prihradce
  49.     move.w    d1,(a2,d3.w*2)    ;zapisujem d1
  50.     dbra    d7,utlab2
  51.  
  52.  
  53.     move.l    #ukpp,a0
  54.     move.l    #pole+200,a2
  55.     
  56.     moveq    #16-1,d7    
  57. utlab5    move.l    (a0)+,a1
  58.     move.w    (a1)+,d3        ;pocet prvku -> d3
  59.     beq    utlab9        ;neni tam zadnej - specialni pripad
  60.     sub.w    #1,d3        ;kvuli spravnemu poctu pruchodu cyklem
  61. utlab4    move.w    (a1)+,-(a2)    ;zapiseme do pole
  62.     dbra    d3,utlab4
  63. utlab9    dbra    d7,utlab5
  64.     addq    #4,d6
  65.     cmp    #16,d6
  66.     bne    utlab7
  67.     rts
  68.     
  69.     
  70.  
  71. vypis    move.l    #pole,a5
  72.     moveq    #100-1,d6
  73.     
  74. vyplab2    moveq    #4-1,d7
  75.     moveq    #0,d0
  76.     move.w    (a5)+,d0        ;v d0 je cislo
  77.     move.l    #cislo,a1        ;adresa vypisovaneho bufferu
  78.     swap    d0
  79.     
  80. vyplab1    rol.l    #4,d0
  81.     add.w    #48,d0
  82.     cmp.w    #58,d0
  83.     bcs    noch
  84.     add.w    #7,d0
  85. noch    move.b    d0,(a1)+
  86.     clr.w    d0
  87.     dbf    d7,vyplab1
  88.     
  89.     move.l    vystup,d1
  90.     move.l    #cislo,d2
  91.     moveq    #5,d3
  92.     CALLDOS    Write
  93.     dbf    d6,vyplab2
  94.     
  95.     move.l    vystup,d1
  96.     move.l    #odrad,d2
  97.     move.l    #2,d3
  98.     CALLDOS    Write
  99.     rts
  100.  
  101. Generuj    ;procedura vygeneruje nahodna cisla - 100 wordu
  102.     moveq    #100-1,d7
  103.     move.l    #pole,a0
  104.     move.l    #$FFFF,d0
  105. genlab    bsr    Rnd
  106.     move.w    d1,(a0)+
  107.     dbf    d7,genlab
  108.     rts
  109.  
  110.     ; D0 - Range (0 - x)
  111.     ; D1 - Returns Number (Long Word, But Only Grab Word!)
  112.     
  113. Rnd    Move.w    .seed(pc),d1    ;rnd by Ballfrog
  114.     Mulu    #9377,d1
  115.     Add.w    #1,d1    ;9439
  116.     Move.w    d1,.seed        ; Store Value For Seed Next Time
  117.     And.l    #$7FFF,d1        ; Make Sure Positive Word
  118.  
  119.     Divu    d0,d1
  120.     Swap    d1            ; Make Remainder Low Word
  121.     Rts
  122.     
  123. .seed    dc.w    1
  124.  
  125.  
  126.     
  127. Start    move.l    (sp)+,a5        ;vybereme navratovou adresu
  128.  
  129.     moveq    #39,d0
  130.     move.l    #dosname,a1
  131.     CALLEXEC    OpenLibrary
  132.     tst.l    d0
  133.     beq    konec1
  134.     move.l    d0,_DOSBase
  135.     
  136.     move.l    #newvystup,d1
  137.     move.l    #MODE_NEWFILE,d2
  138.     CALLDOS    Open
  139.     tst.l    d0
  140.     beq    konec2
  141.     move.l    d0,vystup
  142.  
  143.     jmp    (a5)    ;vse v poradku - vyskocime
  144.     
  145.     
  146. ***Data***
  147.  
  148. dosname    dc.b    'dos.library',0
  149. newvystup    dc.b    'con:0/0/624/250/Radix/close/wait',0
  150.  
  151. _DOSBase    ds.l    1
  152. vystup    ds.l    1
  153.  
  154. cislo    dc.b    0,0,0,0,32,0
  155.     cnop    0,2
  156.     
  157. odrad    dc.b    10,10
  158.  
  159. pole    dcb.w    100,$00
  160.     
  161. ukpp    dcb.l    16,$0000
  162.     
  163. pompole    dcb.w    100*16,$00    
  164.